home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / lalr.lha / lalr / src / Gen.mi < prev    next >
Text File  |  1992-08-18  |  23KB  |  856 lines

  1. (* generate the parser *)
  2.  
  3. (* $Id: Gen.mi,v 2.6 1992/08/12 07:04:48 grosch rel $ *)
  4.  
  5. (* $Log: Gen.mi,v $
  6.  * Revision 2.6  1992/08/12  07:04:48  grosch
  7.  * extend parse table TComb over 65535 bytes
  8.  *
  9.  * Revision 2.5  1992/08/12  06:53:34  grosch
  10.  * extend parse table TComb over 65535 bytes
  11.  *
  12.  * Revision 2.4  1992/08/07  15:22:49  grosch
  13.  * allow several scanner and parsers; extend module Errors
  14.  *
  15.  * Revision 2.3  1992/01/30  14:08:30  grosch
  16.  * redesign of interface to operating system
  17.  *
  18.  * Revision 2.2  1991/12/04  16:23:39  grosch
  19.  * unified escape conventions for all tools
  20.  *
  21.  * Revision 2.1  1991/11/21  14:53:14  grosch
  22.  * new version of RCS on SPARC
  23.  *
  24.  * Revision 2.0  91/03/08  18:31:42  grosch
  25.  * turned tables into initialized arrays (in C)
  26.  * moved mapping tokens -> strings from Errors to Parser
  27.  * changed interface for source position
  28.  * 
  29.  * Revision 1.4  90/12/20  19:26:39  grosch
  30.  * removed time stamp from tables
  31.  * 
  32.  * Revision 1.3  90/06/12  17:17:20  grosch
  33.  * layout improvements
  34.  * 
  35.  * Revision 1.2  90/06/12  16:54:10  grosch
  36.  * renamed main program to lalr, added { } for actions, layout improvements
  37.  * 
  38.  * Revision 1.1     89/10/18  19:41:35  grosch
  39.  * renamed ScanTab and ParsTab to Scan.Tab and Pars.Tab because of PCTE
  40.  * 
  41.  * Revision 1.0     88/10/04  14:36:17  vielsack
  42.  * Initial revision
  43.  * 
  44.  *)
  45.  
  46. IMPLEMENTATION MODULE Gen;
  47.  
  48.   FROM Actions IMPORT tActionMode, PutAction, WriteActions, ScannerName, ParserName;
  49.   FROM ArgCheck IMPORT ExpandLine, MakeFileName, Scanner, Parser, ExtDef, ExtImp, LineFlag;
  50.  
  51.   FROM Automaton IMPORT
  52.     Infinite,
  53.     tStateKind,
  54.     tRep,
  55.     tIndex,
  56.     tProdIndex,
  57.     tProduction,
  58.     ProdArrayPtr, ProdIndex,
  59.     NextProdIndex,
  60.     ProdCount,
  61.     ProdList,
  62.     tStateIndex,
  63.     StateArrayPtr, StateIndex,
  64.     tItemIndex,
  65.     ItemArrayPtr,
  66.     StartSymbol;
  67.   
  68.   FROM Compress IMPORT
  69.     InitCompressTable,
  70.     CompressTableLine,
  71.     InitCompressNTable,
  72.     CompressNTableLine,
  73.     TableSize,
  74.     NTableSize,
  75.     Base,
  76.     NBase,
  77.     Control,
  78.     NNext,
  79.     Default;
  80.  
  81.   FROM Continue    IMPORT MakeContinuation;
  82.   FROM Checks    IMPORT CheckWriteOpen;
  83.  
  84.   FROM Default    IMPORT
  85.     CreateDefaultList,
  86.     PutInDefaultList,
  87.     ComputeDefaults,
  88.     GetNextState,
  89.     GetTSortState,
  90.     GetNSortState,
  91.     GetDefaultTableLine;
  92.  
  93.   FROM DynArray    IMPORT MakeArray, ExtendArray, ReleaseArray;
  94.   FROM Errors    IMPORT eString, eError;
  95.   FROM Final    IMPORT MakeFinalToProd;
  96.   FROM General    IMPORT Min;
  97.   FROM GenLang    IMPORT WriteConstants, WriteReduceCode;
  98.   FROM IO    IMPORT StdOutput, EndOfFile, WriteOpen, WriteClose, WriteC, WriteS,
  99.     WriteI, WriteCard, WriteNl;
  100.   
  101.   FROM Lists    IMPORT MakeList, tList;
  102.   IMPORT Lists;
  103.   FROM Sets    IMPORT tSet, MakeSet, ReleaseSet, Extract, Assign, IsEmpty;
  104.   IMPORT Strings; (* Length *)
  105.   FROM StringMem    IMPORT PutString;
  106.   FROM Strings    IMPORT Char, tString, ArrayToString, Append, ReadL, WriteL, SubString;
  107.   FROM Idents    IMPORT tIdent, GetString;
  108.   FROM SysError    IMPORT StatIsBad, SysErrorMessageI;
  109.   FROM SYSTEM    IMPORT ADDRESS, ADR, TSIZE;
  110.   IMPORT System; (* Close *)
  111.   FROM System    IMPORT tFile, OpenOutput, Write;
  112.   FROM Times    IMPORT StepTime;
  113.  
  114.   FROM TokenTab    IMPORT
  115.     MINNonTerm,
  116.     MAXNonTerm,
  117.     MAXTerm,
  118.     PosType,
  119.     TokenType,
  120.     TokenError,
  121.     Vocabulary,
  122.     Terminal,
  123.     GetTokenType,
  124.     TokenToSymbol;
  125.   
  126.   FROM WriteTok IMPORT tLanguage, Language, GenWrTo;
  127.  
  128.   CONST EOL        = 12C;
  129.   CONST InitReduceCount    = 4;
  130.  
  131.   TYPE ControlType    = RECORD Check, Next : TableElmt; END;
  132.  
  133.   VAR TableLine    : tTableLine;
  134.   VAR StateCnt    : tStateIndex;
  135.   VAR FileName    : ARRAY [0..128] OF CHAR;
  136.  
  137.   PROCEDURE GenDefaultActions;
  138.   VAR
  139.     act: tList;
  140.     pos: PosType;
  141.     com: tList;
  142.     cpos: PosType;
  143.     s: tString;
  144.   BEGIN
  145.     MakeList (act); pos.Line := 0;    pos.Column := 0;
  146.     MakeList (com); cpos.Line := 0;    cpos.Column := 0;
  147.  
  148.     IF Language = Modula2 THEN
  149.       ArrayToString ('{', s);
  150.     Append (s,EOL); Lists.Append (act, ADDRESS (PutString (s)));
  151.       ArrayToString ('TYPE', s);
  152.     Append (s,EOL); Lists.Append (act, ADDRESS (PutString (s)));
  153.       ArrayToString ('   tParsAttribute = RECORD', s);
  154.     Append (s,EOL); Lists.Append (act, ADDRESS (PutString (s)));
  155.       ArrayToString ('                       Scan: Scanner.tScanAttribute', s);
  156.     Append (s,EOL); Lists.Append (act, ADDRESS (PutString (s)));
  157.       ArrayToString ('                    END;', s);
  158.     Append (s,EOL); Lists.Append (act, ADDRESS (PutString (s)));
  159.       ArrayToString ('}', s);
  160.     Lists.Append (act, ADDRESS (PutString (s)));
  161.     ELSE (* Language = C *)
  162.       ArrayToString ('{', s);
  163.     Append (s,EOL); Lists.Append (act, ADDRESS (PutString (s)));
  164.       ArrayToString ('typedef struct    { tScanAttribute Scan; } tParsAttribute;', s);
  165.     Append (s,EOL); Lists.Append (act, ADDRESS (PutString (s)));
  166.       ArrayToString ('}', s);
  167.     Lists.Append (act, ADDRESS (PutString (s)));
  168.     END;
  169.     PutAction (Global, act, pos, com, cpos);
  170.   END GenDefaultActions;
  171.  
  172.   PROCEDURE GenCode (Pars: tFile; Def: tFile);
  173.     VAR
  174.       out  : tFile;
  175.       line, rest, String1, String2: tString;
  176.       N       : INTEGER;
  177.     BEGIN
  178.       FindKind;
  179.       MakeNumbers;
  180.       MakeLength;
  181.       MakeLeftHandSide;
  182.       MakeContinuation;
  183.       MakeFinalToProd;
  184.  
  185.       IF Trace THEN
  186.     WriteS (StdOutput,' Time :');
  187.     WriteI (StdOutput,StepTime(),5);
  188.     WriteNl (StdOutput);
  189.       END;
  190.  
  191.       MakeTable;
  192.  
  193.       IF Trace THEN
  194.     WriteS (StdOutput,' Time :');
  195.     WriteI (StdOutput,StepTime(),5);
  196.     WriteNl (StdOutput);
  197.       END;
  198.  
  199.       (* Erzeuge Zerteilertabelle *)
  200.  
  201.       INC (TableSize, LastTerminal);
  202.       INC (NTableSize, LastSymbol);
  203.       IF Language = Modula2 THEN
  204.      MakeFileName (ParserName, Parser, ".Tab", FileName);
  205.      out := OpenOutput (FileName);
  206.      IF StatIsBad (out) THEN
  207.        ArrayToString (FileName, String1);
  208.        SysErrorMessageI (out, eError, eString, ADR (String1));
  209.      ELSE
  210.        PutTables (out);
  211.        System.Close (out);
  212.      END;
  213.       END;
  214.  
  215.       (* Mische den generierten Text in den Rahmen *)
  216.  
  217.       MakeFileName (ParserName, Parser, ExtImp, FileName);
  218.       out := WriteOpen (FileName);
  219.       CheckWriteOpen (out, FileName);
  220.     
  221.       WHILE NOT EndOfFile (Pars) DO
  222.     ReadL (Pars, line);
  223.     IF (Strings.Length (line) >= 2) AND (Char (line, 1) = '$') THEN
  224.       CASE Char (line, 2) OF
  225.       | 'G' : WriteActions  (Global,out, LineFlag);
  226.       | 'T' : WriteConstants(out);
  227.       | 'L' : WriteActions  (Local,out, LineFlag);
  228.       | 'R' : PrepareReduceCode;
  229.           WriteReduceCode (out);
  230.       | 'B' : WriteActions  (Begin,out, LineFlag);
  231.       | 'C' : WriteActions  (Close,out, LineFlag);
  232.       | 'X' : IF CaseFlag THEN
  233.             SubString    (line,3,Strings.Length(line),rest);
  234.             WriteL    (out,rest);
  235.           END;
  236.       | 'W' : GenWrTo    (out);
  237.       | 'P' : PutBase    (out);
  238.       | 'Q' : PutNBase    (out);
  239.       | 'D' : PutDefault    (out);
  240.       | 'M' : PutControl    (out);
  241.       | 'N' : PutNNext    (out);
  242.       | 'K' : PutLength    (out);
  243.       | 'H' : PutLeftHandSide    (out);
  244.       | 'O' : PutContinuation    (out);
  245.       | 'F' : PutFinalToProd    (out);
  246.       | '@' : ExpandLine (out, line);
  247.           END;
  248.         ELSE
  249.       WriteL (out,line);
  250.     END;
  251.       END;
  252.       WriteClose (out);
  253.  
  254.       (* Mische Abschnitt EXPORT in Rahmen *)
  255.  
  256.       IF NOT EndOfFile (Def) THEN
  257.      MakeFileName (ParserName, Parser, ExtDef, FileName);
  258.      out := WriteOpen (FileName);
  259.      CheckWriteOpen (out, FileName);
  260.      WHILE NOT EndOfFile (Def) DO
  261.         ReadL (Def, line);
  262.         IF (Strings.Length (line) >= 2) AND (Char (line, 1) = '$') THEN
  263.            CASE Char (line, 2) OF
  264.            | 'E' : WriteActions  (Export, out, LineFlag);
  265.            | '@' : ExpandLine (out, line);
  266.            END;
  267.         ELSE
  268.            WriteL (out, line);
  269.         END;
  270.      END;
  271.      WriteClose (out);
  272.       END;
  273.     END GenCode;
  274.  
  275.   PROCEDURE FindKind; (* Zustaende klassifizieren und mit einer neuen Nummer versehen *)
  276.     VAR
  277.       maxState,
  278.       state : tStateIndex;
  279.       prod : tProduction;
  280.       item : tItemIndex;
  281.       RepCount : CARDINAL;
  282.       LastItem : tItemIndex;
  283.     BEGIN
  284.       maxState := StateIndex;
  285.       FOR state := 1 TO maxState DO    (* Betrachte alle Zustaende *)
  286.     WITH StateArrayPtr^[state] DO
  287.       IF Size = 1 THEN
  288.         RepCount := 1;
  289.         item := Items;
  290.       ELSE
  291.         RepCount := 0;
  292.         FOR item := Items TO Items + Size - 1 DO
  293.         WITH ItemArrayPtr^[item] DO
  294.           IF Rep # NoRep THEN
  295.         INC (RepCount);
  296.         LastItem := item;
  297.           END;
  298.         END;
  299.         END;
  300.         item := LastItem;
  301.       END;
  302.  
  303.       IF RepCount = 1 THEN        (* Zustand enthaelt nur ein Item *)
  304.         WITH ItemArrayPtr^[item] DO
  305.           IF Rep = RedRep THEN    (* es handelt sich um eine Reduktion *)
  306.         prod := ADR (ProdArrayPtr^[Prod]); (* beschaffe zugh. Produktion *)
  307.         WITH prod^ DO
  308.           IF Right[Len] > MAXTerm THEN (* letztes Symbol war ein Nichtterminal *)
  309.             Kind := sNonterm;
  310.           ELSE            (* letztes Symbol war ein Terminal *)
  311.             Kind := sTerm;
  312.           END;
  313.         END;
  314.           ELSE            (* es handelt sich um einen Read-Zustand *)
  315.         Kind := sRead;
  316.           END;
  317.         END;
  318.       ELSE                (* Zustand mit mehreren Items, die Repraesanten sind,
  319.                        muss ein Read-Zustand sein *)
  320.         Kind := sRead;
  321.       END;
  322.     END;
  323.       END;
  324.     END FindKind;
  325.  
  326.   PROCEDURE MakeNumbers;
  327.   VAR
  328.     maxState, state : tStateIndex;
  329.     prod : tProduction;
  330.     remember : tStateIndex;
  331.   BEGIN
  332.       FirstTerminal := FindFirstTerminal();
  333.       LastTerminal  := FindLastTerminal();
  334.       NonTermOffset := MINNonTerm - LastTerminal - 1;
  335.       FirstSymbol   := FirstTerminal;
  336.       LastSymbol    := FindLastSymbol()-NonTermOffset;
  337.       StateCnt        := 0;
  338.       maxState        := StateIndex;
  339.       FirstState    := 1;
  340.  
  341.       (* Trage neue Nummern fuer ReadStates ein *)
  342.  
  343.       FirstReadState := StateCnt+1;
  344.       FOR state := 1 TO maxState DO
  345.     WITH StateArrayPtr^[state] DO
  346.       IF Kind = sRead THEN
  347.         INC(StateCnt);
  348.         NewNumber := StateCnt;
  349.       END;
  350.     END;
  351.       END;
  352.       LastReadState := StateCnt;
  353.  
  354.       (* Trage neue Nummern fuer ReadTermStates ein *)
  355.  
  356.       FirstReadTermState := StateCnt+1;
  357.       FOR state := 1 TO maxState DO
  358.     WITH StateArrayPtr^[state] DO
  359.       IF Kind = sTerm THEN
  360.         prod := ADR (ProdArrayPtr^[ItemArrayPtr^[Items].Prod]);
  361.         IF prod^.Left = StartSymbol THEN
  362.           remember := state;   (* Stopzustand kommt in andere Gruppe *)
  363.         ELSE
  364.           INC(StateCnt);
  365.           NewNumber := StateCnt;
  366.         END;
  367.       END;
  368.     END;
  369.       END;
  370.       LastReadTermState := StateCnt;
  371.  
  372.       (* Trage neue Nummern fuer ReadNonTermStates ein *)
  373.  
  374.       FirstReadNonTermState := StateCnt+1;
  375.       FOR state := 1 TO maxState DO
  376.     WITH StateArrayPtr^[state] DO
  377.       IF Kind = sNonterm THEN
  378.         INC(StateCnt);
  379.         NewNumber := StateCnt;
  380.       END;
  381.     END;
  382.       END;
  383.       LastReadNonTermState := StateCnt;
  384.  
  385.       (* Nummern fuer ReduceStates *)
  386.  
  387.       ReduceOffset := StateCnt;
  388.       WITH StateArrayPtr^[remember] DO
  389.     prod := ADR(ProdArrayPtr^[ItemArrayPtr^[Items].Prod]);
  390.     NewNumber := prod^.ProdNo + ReduceOffset;
  391.       END;
  392.  
  393.       FirstReduceState    := StateCnt+1;
  394.       LastReduceState    := ReduceOffset+ProdCount;
  395.       StopState        := FirstReduceState;
  396.       LastState        := LastReduceState;
  397.     END MakeNumbers;
  398.  
  399.   PROCEDURE MakeTable;
  400.     VAR
  401.       maxState : tStateIndex;
  402.       state    : tStateIndex;
  403.       index    : tStateIndex;
  404.       NewNum   : tStateIndex;
  405.       DefaultState  : tStateIndex;
  406.     BEGIN
  407.  
  408.       (* Erstellen der Listen fuer Defaultberechnung *)
  409.  
  410.       CreateDefaultList;
  411.       maxState := StateIndex;
  412.       FOR state := 1 TO maxState DO
  413.     InitTableLine;
  414.     NewNum := MakeTableLine (state);
  415.     IF NewNum <= LastReadState THEN
  416.       PutInDefaultList (NewNum, TableLine);
  417.     END;
  418.       END;
  419.  
  420.       (* Berechnung der Defaults *)
  421.  
  422.       ComputeDefaults;
  423.  
  424.       (* Comprimieren der Tabelle *)
  425.  
  426. (* - - - alternative 1a 
  427.       InitCompressTable;
  428.       NewNum := GetNextState (NoState);
  429.       WHILE NewNum # NoState DO
  430.     GetDefaultTableLine (NewNum, TableLine, DefaultState);
  431.     CompressTableLine (NewNum, DefaultState, TableLine);
  432.     NewNum := GetNextState (NewNum);
  433.       END;
  434.  - - - *)
  435.  
  436. (* - - - alternative 1b *)
  437.       InitCompressTable;
  438.       FOR index := 1 TO LastReadState DO
  439.     NewNum := GetTSortState (index);
  440.     GetDefaultTableLine (NewNum, TableLine, DefaultState);
  441.     CompressTableLine (NewNum, DefaultState, TableLine);
  442.       END;
  443. (*- - - *)
  444.  
  445. (* - - -  alternative  2a 
  446.       InitCompressNTable;
  447.       NewNum := GetNextState (NoState);
  448.       WHILE NewNum # NoState DO
  449.     GetDefaultTableLine (NewNum, TableLine, DefaultState);
  450.     CompressNTableLine (NewNum, TableLine);
  451.     NewNum := GetNextState (NewNum);
  452.       END;
  453.  - - - *)
  454.  
  455. (* - - -  alternative  2b *)
  456.       InitCompressNTable;
  457.       FOR index := 1 TO LastReadState DO
  458.     NewNum := GetNSortState (index);
  459.     GetDefaultTableLine (NewNum, TableLine, DefaultState);
  460.     CompressNTableLine (NewNum, TableLine);
  461.       END;
  462. (* - - - *)
  463.     END MakeTable;
  464.  
  465.   PROCEDURE InitTableLine;
  466.     VAR
  467.       state : tStateIndex;
  468.       symbol : Vocabulary;
  469.     BEGIN
  470.       FOR symbol := FirstSymbol TO LastSymbol DO
  471.     TableLine[symbol] := NoState;
  472.       END;
  473.     END InitTableLine;
  474.   
  475.   PROCEDURE MakeTableLine (state : tStateIndex) : tStateIndex;
  476.     VAR
  477.       RedState : tStateIndex;
  478.       maxState : tStateIndex;
  479.       item : tItemIndex;
  480.       prod : tProduction;
  481.       Look : tSet;
  482.       t : Terminal;
  483.     BEGIN
  484.       MakeSet (Look, MAXTerm);
  485.  
  486.       (* alle States *)
  487.  
  488.       WITH StateArrayPtr^[state] DO
  489.  
  490.     (* nur ReadStates *)
  491.  
  492.     IF Kind = sRead THEN
  493.  
  494.       (* alle Items *)
  495.  
  496.       FOR item := Items TO Items + Size - 1 DO
  497.       WITH ItemArrayPtr^[item] DO
  498.         CASE Rep OF
  499.         | TermRep:
  500.         TableLine[Read] := StateArrayPtr^[Next].NewNumber;
  501.         | NonTermRep:
  502.         TableLine[Read-NonTermOffset] := StateArrayPtr^[Next].NewNumber;
  503.         | RedRep:
  504.         prod := ADR(ProdArrayPtr^[Prod]);
  505.         RedState := ReduceOffset + prod^.ProdNo;
  506.         Assign (Look,Set);
  507.         WHILE NOT IsEmpty (Look) DO
  508.           t := Extract(Look);
  509.           TableLine[t] := RedState;
  510.         END;
  511.           ELSE
  512.         END;
  513.       END;
  514.       END;
  515.     END;
  516.  
  517.     ReleaseSet (Look);
  518.     RETURN (NewNumber);
  519.       END;
  520.     END MakeTableLine;
  521.  
  522.   PROCEDURE MakeLength;
  523.     VAR
  524.       prod : tProduction;
  525.       index,prodno: tProdIndex;
  526.     BEGIN
  527.       LengthCount := ProdCount;
  528.       MakeArray (Length,LengthCount,ElmtSize);
  529.       index := 0;
  530.       FOR prodno := 1 TO ProdCount DO
  531.     prod := ADR(ProdArrayPtr^[index]);
  532.     Length^[prodno] := prod^.Len;
  533.     index := NextProdIndex(index);
  534.       END;
  535.     END MakeLength;  
  536.  
  537.   PROCEDURE MakeLeftHandSide;
  538.     VAR
  539.       prod : tProduction;
  540.       index,prodno: tProdIndex;
  541.     BEGIN
  542.       LeftHandSideCount := ProdCount;
  543.       MakeArray (LeftHandSide,LeftHandSideCount,ElmtSize);
  544.       index := 0;
  545.       FOR prodno := 1 TO ProdCount DO
  546.     prod := ADR(ProdArrayPtr^[index]);
  547.     LeftHandSide^[prodno] := prod^.Left - NonTermOffset;
  548.     index := NextProdIndex(index);
  549.       END;
  550.     END MakeLeftHandSide;  
  551.  
  552.   PROCEDURE FindFirstTerminal ():Vocabulary;
  553.     BEGIN
  554.       RETURN 0;            (* EndOfToken wird immer mit 0 codiert *)
  555.     END FindFirstTerminal;
  556.  
  557.   PROCEDURE FindLastTerminal ():Vocabulary;
  558.     VAR sym : Vocabulary;
  559.     BEGIN
  560.       sym := MAXTerm;
  561.       LOOP
  562.     IF GetTokenType (sym) = Term THEN RETURN sym END;
  563.     DEC (sym);
  564.       END;
  565.     END FindLastTerminal;
  566.  
  567.   PROCEDURE FindLastSymbol ():Vocabulary;
  568.     VAR sym : Vocabulary;
  569.     BEGIN
  570.       sym := MAXNonTerm;
  571.       LOOP
  572.     IF GetTokenType (sym) # None THEN RETURN sym END;
  573.     DEC (sym);
  574.       END;
  575.     END FindLastSymbol;
  576.  
  577.   PROCEDURE StartState ():CARDINAL;
  578.     BEGIN
  579.       RETURN StateArrayPtr^[1].NewNumber;
  580.     END StartState;
  581.  
  582.   PROCEDURE PrepareReduceCode;
  583.     VAR
  584.       index : tProdIndex;
  585.       prod  : tProduction;
  586.       maxState,state : tStateIndex;
  587.       maxProdIndex : tProdIndex;
  588.       u : LONGINT;
  589.       item : tItemIndex;
  590.     BEGIN
  591.       (* Felder fuer Statelisten initialisieren *)
  592.  
  593.       index := 0;
  594.       state := ReduceOffset;
  595.       maxProdIndex := ProdIndex;
  596.       WHILE index < maxProdIndex DO
  597.     INC (state);
  598.     prod := ADR (ProdArrayPtr^[index]);
  599.     WITH prod^.Reduce DO
  600.       Count := InitReduceCount;
  601.       MakeArray (Array, Count, TSIZE(tIndex));
  602.       Used := 1;
  603.       Array^[1] := state; (* Reduce State *)
  604.     END;
  605.     index := NextProdIndex(index);
  606.       END;
  607.  
  608.       (* Felder ausfuellen *)
  609.  
  610.       maxState := StateIndex;
  611.       FOR state := 1 TO maxState DO
  612.     WITH StateArrayPtr^[state] DO
  613.       IF (Kind = sTerm) OR (Kind = sNonterm) THEN
  614.  
  615.         (* Read-Terminal- bzw. Read-Nonterminal-Reducee *)
  616.         (* Finde erste Item, das Repraesentant ist *)
  617.  
  618.         item := Items;
  619.         LOOP
  620.           IF ItemArrayPtr^[item].Rep # NoRep THEN
  621.         EXIT;
  622.           END;
  623.           INC (item);
  624.         END;
  625.  
  626.         (* bestimme zugh. Produktion *)
  627.  
  628.         IF NewNumber <= ReduceOffset THEN
  629.         (* StopState ausfiltern *)
  630.  
  631.           index := ItemArrayPtr^[item].Prod;
  632.           prod := ADR (ProdArrayPtr^[index]);
  633.           WITH prod^.Reduce DO
  634.         INC (Used);
  635.         IF Used > Count THEN
  636.           ExtendArray (Array,Count,TSIZE(tIndex));
  637.         END;
  638.         Array^[Used] := NewNumber;
  639.           END;
  640.         END;
  641.       END;
  642.     END;
  643.       END;
  644.     END PrepareReduceCode;
  645.  
  646. PROCEDURE PutTables (TableFile: tFile);
  647.   VAR InError        : BOOLEAN;
  648.       BlockSize    , i    : CARDINAL;
  649.  
  650.     PROCEDURE PutTable (Length: TableElmt; Address: ADDRESS);
  651.        VAR
  652.       N    : INTEGER;
  653.       string: tString;
  654.        BEGIN
  655.       N := Write (TableFile, ADR (Length), ElmtSize);
  656.       IF StatIsBad (N) THEN
  657.         ArrayToString (FileName, string);
  658.         SysErrorMessageI (N, eError, eString, ADR (string));
  659.         InError := TRUE;
  660.         RETURN;
  661.       END;
  662.       N := Write (TableFile, Address, Length);
  663.       IF StatIsBad (N) THEN
  664.         ArrayToString (FileName, string);
  665.         SysErrorMessageI (N, eError, eString, ADR (string));
  666.         InError := TRUE;
  667.         RETURN;
  668.       END;
  669.        END PutTable;
  670.  
  671.    BEGIN
  672.       BlockSize    := 64000 DIV TSIZE (ControlType);
  673.       InError := FALSE;
  674.       PutTable ((LastReadState + 1) * ElmtSize, Base);
  675.       IF InError THEN RETURN END;
  676.       PutTable ((LastReadState + 1) * ElmtSize, NBase);
  677.       IF InError THEN RETURN END;
  678.       PutTable ((LastReadState + 1) * ElmtSize, Default);
  679.       IF InError THEN RETURN END;
  680.       PutTable ((NTableSize - LastTerminal) * TSIZE (TableElmt), ADR (NNext^[LastTerminal + 1]));
  681.       IF InError THEN RETURN END;
  682.       PutTable ((LastReduceState - FirstReduceState + 1) * ElmtSize, Length);
  683.       IF InError THEN RETURN END;
  684.       PutTable ((LastReduceState - FirstReduceState + 1) * ElmtSize, LeftHandSide);
  685.       IF InError THEN RETURN END;
  686.       PutTable ((LastReadState + 1) * ElmtSize, Continuation);
  687.       IF InError THEN RETURN END;
  688.       PutTable ((LastReadNonTermState - FirstReadTermState + 1) * ElmtSize, FinalToProd);
  689.       IF InError THEN RETURN END;
  690.  
  691.       i := 0;
  692.       WHILE i <= TableSize DO
  693.      PutTable (Min (BlockSize, TableSize + 1 - i) * TSIZE (ControlType), ADR (Control^[i]));
  694.      IF InError THEN RETURN END;
  695.          INC (i, BlockSize);
  696.       END;
  697.    END PutTables;
  698.  
  699. PROCEDURE PutBase    (File: tFile);
  700.    VAR i: tStateIndex;
  701.    BEGIN
  702.       FOR i := 0 TO LastReadState DO
  703.      WriteS (File, '& yyTComb [');
  704.      WriteI (File, Base^[i], 0); WriteS (File, '],'); WriteNl (File);
  705.       END;
  706.    END PutBase;
  707.  
  708. PROCEDURE PutNBase    (File: tFile);
  709.    VAR i: tStateIndex;
  710.    BEGIN
  711.       FOR i := 0 TO LastReadState DO
  712.      WriteS (File, '& yyNComb [');
  713.      WriteI (File, SHORTINT (NBase^[i]) - SHORTINT (LastTerminal) - 1, 0);
  714.      WriteS (File, '],'); WriteNl (File);
  715.       END;
  716.    END PutNBase;
  717.  
  718. PROCEDURE PutDefault    (File: tFile);
  719.    VAR i: tStateIndex;
  720.    BEGIN
  721.       FOR i := 0 TO LastReadState DO
  722.      WriteI (File, Default^[i], 0); WriteC (File, ','); WriteNl (File);
  723.       END;
  724.    END PutDefault;
  725.  
  726. PROCEDURE PutControl    (File: tFile);
  727.    VAR i: CARDINAL;
  728.    BEGIN
  729.       FOR i := 0 TO TableSize DO
  730.      WriteC (File, '{');
  731.      WriteI (File, Control^[i].Check, 0); WriteS (File, ', ');
  732.      WriteI (File, Control^[i].Next , 0); WriteS (File, '},'); WriteNl (File);
  733.       END;
  734.    END PutControl;
  735.  
  736. PROCEDURE PutNNext    (File: tFile);
  737.    VAR i: tStateIndex;
  738.    BEGIN
  739.       FOR i := LastTerminal + 1 TO NTableSize DO
  740.      WriteI (File, NNext^[i], 0); WriteC (File, ','); WriteNl (File);
  741.       END;
  742.    END PutNNext;
  743.  
  744. PROCEDURE PutLength    (File: tFile);
  745.    VAR i: tStateIndex;
  746.    BEGIN
  747.       FOR i := 1 TO ProdCount DO
  748.      WriteI (File, Length^[i], 0); WriteC (File, ','); WriteNl (File);
  749.       END;
  750.    END PutLength;
  751.  
  752. PROCEDURE PutLeftHandSide    (File: tFile);
  753.    VAR i: tStateIndex;
  754.    BEGIN
  755.       FOR i := 1 TO ProdCount DO
  756.      WriteI (File, LeftHandSide^[i], 0); WriteC (File, ','); WriteNl (File);
  757.       END;
  758.    END PutLeftHandSide;
  759.  
  760. PROCEDURE PutContinuation    (File: tFile);
  761.    VAR i: tStateIndex;
  762.    BEGIN
  763.       FOR i := 0 TO LastReadState DO
  764.      WriteI (File, Continuation^[i], 0); WriteC (File, ','); WriteNl (File);
  765.       END;
  766.    END PutContinuation;
  767.  
  768. PROCEDURE PutFinalToProd    (File: tFile);
  769.    VAR i: tStateIndex;
  770.    BEGIN
  771.       FOR i := FirstReadTermState TO LastReadNonTermState DO
  772.     
  773.      WriteI (File, FinalToProd^[i - FirstReadTermState], 0);
  774.      WriteC (File, ','); WriteNl (File);
  775.       END;
  776.    END PutFinalToProd;
  777.  
  778. (* +++ 
  779.  
  780.   PROCEDURE PrintTable;
  781.     VAR maxState, state, NewNum : tStateIndex;
  782.     BEGIN
  783.       WriteS (StdOutput,'***** Table ***** ');
  784.       WriteNl (StdOutput);
  785.       maxState := StateIndex;
  786.       FOR state := 1 TO maxState DO
  787.     InitTableLine;
  788.     NewNum := MakeTableLine (state);
  789.     IF NewNum <= LastReadState THEN
  790.       PrintTableLine (NewNum);
  791.     END;
  792.       END;
  793.     END PrintTable;
  794.  
  795.   PROCEDURE PrintTableLine (state:tStateIndex);
  796.     VAR
  797.       nextstate : tStateIndex;
  798.       symbol : Vocabulary;
  799.     BEGIN
  800.       WriteS (StdOutput,'State ');
  801.       WriteCard (StdOutput,state,1);
  802.       WriteC (StdOutput,':');
  803.       FOR symbol := FirstSymbol TO LastSymbol DO
  804.     nextstate := TableLine [symbol];
  805.     IF nextstate # NoState THEN
  806.       WriteS (StdOutput,' (');
  807.       IF symbol > LastTerminal THEN
  808.         PrintToken (symbol+NonTermOffset);
  809.       ELSE
  810.         PrintToken (symbol);
  811.       END;
  812.       WriteC (StdOutput,',');
  813.       WriteCard (StdOutput,nextstate,1);
  814.       WriteC (StdOutput,')');
  815.     END;
  816.       END;
  817.       WriteNl (StdOutput);
  818.     END PrintTableLine;
  819.  
  820.   PROCEDURE PrintLength;
  821.     VAR prodno : tProdIndex;
  822.     BEGIN
  823.       WriteS (StdOutput,'***** Length ***** ');
  824.       WriteNl (StdOutput);
  825.       FOR prodno := 1 TO ProdCount DO
  826.     WriteS (StdOutput,'Length (');
  827.     WriteCard (StdOutput,prodno,1);
  828.     WriteS (StdOutput,') = ');
  829.     WriteCard (StdOutput,Length^[prodno],1);
  830.     WriteNl (StdOutput);
  831.       END;
  832.       WriteNl (StdOutput);
  833.     END PrintLength;
  834.  
  835.   PROCEDURE PrintLeftHandSide;
  836.     VAR prodno : tProdIndex;
  837.     BEGIN
  838.       WriteS (StdOutput,'***** LeftHandSide ***** ');
  839.       WriteNl (StdOutput);
  840.       FOR prodno := 1 TO ProdCount DO
  841.     WriteS (StdOutput,'LeftHandSide (');
  842.     WriteCard (StdOutput,prodno,1);
  843.     WriteS (StdOutput,') = ');
  844.     PrintToken (LeftHandSide^[prodno]);
  845.     WriteNl (StdOutput);
  846.       END;
  847.       WriteNl (StdOutput);
  848.     END PrintLeftHandSide;
  849.  --- *)
  850.  
  851. BEGIN
  852.   ElmtSize    := TSIZE (TableElmt);
  853.   Trace        := FALSE;
  854.   CaseFlag    := FALSE;
  855. END Gen.
  856.